home *** CD-ROM | disk | FTP | other *** search
/ CU Amiga Super CD-ROM 18 / CU Amiga Magazine's Super CD-ROM 18 (1997)(EMAP Images)(GB)[!][issue 1998-01].iso / CUCD / Programming / AmigaE / Src / OOmodules / list / associativeArray.e next >
Encoding:
Text File  |  1996-01-28  |  15.0 KB  |  567 lines
  1. OPT MODULE
  2. OPT REG=5,
  3.     PREPROCESS
  4.  
  5. MODULE  'oomodules/object'
  6.  
  7. -> #define NO_SAFE_STACK 1  -> Uncomment if you don't want to watch the stack.
  8. #define PIVOT(l,u) ((l)+(Div(((u)-(l)),(2))))
  9.  
  10. /*
  11.  * Exceptions.
  12.  *
  13.  * ASAR_EXCEPTION identifies this module as the origin of the exception.  The
  14.  * remaining constants identify the reason for an exception raised by this
  15.  * module, eg:
  16.  *
  17.  *   Throw(ASAR_EXCEPTION, ASAR_KEYNOTFOUND)
  18.  */
  19. EXPORT CONST ASAR_EXCEPTION="AsAr"
  20. EXPORT CONST ASAR_KEYNOTFOUND="key",
  21.              ASAR_STACKOVERFLOW="stak"
  22.  
  23. CONST DEFAULT_LENGTH=64
  24.  
  25. EXPORT OBJECT associativeArray OF object
  26. /****** object/associativeArray ******************************
  27.  
  28.     NAME
  29.         associativeArray of object -- Dynamic, one-dimensional, ordered
  30.             array
  31.  
  32.     PURPOSE
  33.         Dynamic, one-dimensional, ordered array for storing things whose
  34.         indices fit any of these criteria:  1) are non-numeric (most
  35.         popular index type is a string), 2) are not consecutive and/or
  36.         have big gaps between values (commonly known as sparse arrays),
  37.         3) order cannot be simply determined by builtin E arithmetic
  38.         operators (=<>).  Basically any index type that is not the typical
  39.         positive integer from 0 to MAXLONG.
  40.  
  41.     ATTRIBUTES
  42.         len:LONG -- current max length of the array
  43.  
  44.         tail:LONG -- first empty place after the last element
  45.  
  46.         key:PTR TO LONG -- array stores the keys in ordered sequence
  47.  
  48.         val:PTR TO LONG -- array stores the values associated with each key
  49.             in array key
  50.  
  51.     EXCEPTIONS
  52.         ASAR_EXCEPTION identifies this module as the origin of the exception.
  53.         The remaining constants identify the reason for an exception raised
  54.         by this module. These are:
  55.  
  56.             ASAR_KEYNOTFOUND -- there is no such key in the array
  57.  
  58.             ASAR_STACKOVERFLOW -- stack overflow. Should not be raised if the
  59.                 stack watch is enabled.
  60.  
  61.     NOTES
  62.         disposeKey(key)
  63.         disposeVal(val)
  64.  
  65.         These are the default actions for disposal of keys and vals of type
  66.         LONG, which is "do nothing", since they require no special cleanup.
  67.         Override them if key and/or val requires cleanup, (ie, dynamically
  68.         allocated, else your storage WILL NOT be freed when you set() or end()!!!)
  69.  
  70.         EXAMPLE:
  71.  
  72.         PROC disposeVal(val) OF myAsAr IS DisposeLink(val)
  73.  
  74.         Storage for new elements is automatically allocated, increased by 32
  75.         each time the array's limits are exceeded.
  76.  
  77.         No duplicate keys will ever exist, values are simply overwritten.
  78.  
  79.         Inserting and removing from the front of the array is SLOW with large
  80.         arrays.  This can't be helped, however it's often worth the sacrifice
  81.         for the efficient lookup of binary searches and the handiness of
  82.         sparse, non-numeric indexed arrays.
  83.  
  84.         The binary search function uses recursion and has a FreeStack() check.
  85.         4096 should be plenty for most applications since the algorithm is
  86.         amazingly efficient.
  87.  
  88.         Changing any of the PUBLIC (READ-ONLY) values in the object isn't
  89.         recommended, but hey, who's to stop ya besides the guru? :)
  90.  
  91.     SEE ALSO
  92.         object
  93.  
  94. ********/
  95.   len:  LONG
  96.   tail: LONG
  97.   key:  PTR TO LONG
  98.   val:  PTR TO LONG
  99. ENDOBJECT
  100.  
  101.  
  102. /* Local. */
  103. CONST LT=-1,
  104.       EQ=0,
  105.       GT=1
  106.  
  107. /*===========================================================================*/
  108. /*=== Con/Destructors =======================================================*/
  109. /*===========================================================================*/
  110.  
  111. /*
  112.  * original new() contents:
  113.  *    self.end()
  114.  *    self.key:=NewR(Mul(length, 4))
  115.  *    self.val:=NewR(Mul(length, 4))
  116.  *    self.len:=length
  117.  *    self.tail:=0
  118.  *
  119.  * length is the initial number of empty elements in the array
  120.  */
  121.  
  122. PROC init() OF associativeArray
  123. /****** associativeArray/init ******************************
  124.  
  125.     NAME
  126.         init() of associativeArray -- Initialization of the object.
  127.  
  128.     SYNOPSIS
  129.         associativeArray.init()
  130.  
  131.     FUNCTION
  132.         Initializes the object. The list will initially contain
  133.         DEFAULT_LENGTH elements.
  134.  
  135.     EXCEPTION
  136.         May raise "MEM".
  137.  
  138.     SEE ALSO
  139.         associativeArray
  140.  
  141. ********/
  142.  
  143.   self.key:=NewR(Mul(DEFAULT_LENGTH, 4))
  144.   self.val:=NewR(Mul(DEFAULT_LENGTH, 4))
  145.   self.len:=DEFAULT_LENGTH
  146.   self.tail:=0
  147.  
  148. ENDPROC
  149.  
  150.  
  151. PROC end() OF associativeArray
  152. /****** associativeArray/end ******************************
  153.  
  154.     NAME
  155.         end() of associativeArray -- Global destructor.
  156.  
  157.     SYNOPSIS
  158.         associativeArray.end()
  159.  
  160.     FUNCTION
  161.         Cleans up keys and values using methods disposeKey() and disposeVal(),
  162.         so if your keys and values are dynamically allocated, you must
  163.         override these if you want this method to free them.  NOTE: this
  164.         method was written to be very safe!  It may be called directly at any
  165.         time (even multiple times) to free resources.  'myobj.end()' doesn't
  166.         free the object, only its contents.  Just don't be so silly as to
  167.         call -any- methods after an 'END myobj'. :)
  168.  
  169.     SEE ALSO
  170.         associativeArray
  171.  
  172. ********/
  173.   DEF i, last, ar:PTR TO LONG
  174.   last:=self.tail-1
  175.   IF ar:=self.key
  176.     FOR i:=0 TO last DO self.disposeKey(ar[i])
  177.     Dispose(ar)
  178.     self.key:=NIL
  179.   ENDIF
  180.   IF ar:=self.val
  181.     FOR i:=0 TO last DO self.disposeVal(ar[i])
  182.     Dispose(ar)
  183.     self.val:=NIL
  184.   ENDIF
  185.   self.tail:=0
  186. ENDPROC
  187.  
  188. /*===========================================================================*/
  189. /*=== Tell-me-about-myself Methods ==========================================*/
  190. /*===========================================================================*/
  191.  
  192. PROC disposeKey(key) OF associativeArray IS EMPTY
  193. /****** associativeArray/disposeKey ******************************
  194.  
  195.     NAME
  196.         disposeKey() of associativeArray -- Call destructor of key.
  197.  
  198.     SYNOPSIS
  199.         associativeArray.disposeKey(LONG)
  200.  
  201.         associativeArray.disposeKey(key)
  202.  
  203.     FUNCTION
  204.         Empty method. Special action to take when calling the destructor for
  205.         an array whose keys are dynamically allocated.  Default for type LONG
  206.         is NO ACTION.
  207.  
  208.     INPUTS
  209.         key:LONG -- Pointer to key.
  210.  
  211.     SEE ALSO
  212.         associativeArray, disposeVal()
  213.  
  214. ********/
  215.  
  216. PROC disposeVal(val) OF associativeArray IS EMPTY
  217. /****** associativeArray/disposeVal ******************************
  218.  
  219.     NAME
  220.         disposeVal() of associativeArray -- Call destructor of value.
  221.  
  222.     SYNOPSIS
  223.         associativeArray.disposeVal(LONG)
  224.  
  225.         associativeArray.disposeVal(val)
  226.  
  227.     FUNCTION
  228.         Empty method. Special action to take when calling the destructor,
  229.         or overwriting a value for a key that already exists, for an array
  230.         whose keys are dynamically allocated.  Default for type LONG is
  231.         NO ACTION.
  232.  
  233.     INPUTS
  234.         val:LONG -- Pointer to value.
  235.  
  236.     SEE ALSO
  237.         associativeArray, disposeKey()
  238.  
  239. ********/
  240.  
  241. PROC testKey(left, right) OF associativeArray IS IF (right>left) THEN 1 ELSE (right<left)
  242. /****** associativeArray/testKey ******************************
  243.  
  244.     NAME
  245.         testKey() of associativeArray --
  246.  
  247.     SYNOPSIS
  248.         associativeArray.testKey(LONG, LONG)
  249.  
  250.         associativeArray.testKey(left, right)
  251.  
  252.     FUNCTION
  253.         Ordered comparison of two keys.  Default behavior is for comparison
  254.         of type LONG.  Override this method to change the behavior.
  255.  
  256.     INPUTS
  257.         left:LONG -- the left operand of an infix expression (left = right)
  258.         right:LONG -- the right operand of an infix expression (left = right)
  259.  
  260.     RESULT
  261.        -1 if left is less than right
  262.         0 if left equals right
  263.         1 if left is greater than right
  264.  
  265.     EXAMPLE
  266.        /*
  267.         * simple adaption for strings
  268.         */
  269.  
  270.         PROC testKey(left, right) OF myAsAr IS OstrCmp(left, right)
  271.  
  272.     SEE ALSO
  273.         associativeArray
  274.  
  275. ********/
  276.  
  277. /*===========================================================================*/
  278. /*=== Interactive methods ===================================================*/
  279. /*===========================================================================*/
  280.  
  281. PROC set(key, val) OF associativeArray
  282. /****** associativeArray/set ******************************
  283.  
  284.     NAME
  285.         set() of associativeArray --
  286.  
  287.     SYNOPSIS
  288.         associativeArray.set(LONG, LONG)
  289.  
  290.         associativeArray.get(key, val)
  291.  
  292.     FUNCTION
  293.         Overwrites the value associated with key if it already exists, else
  294.         inserts it ordered on key.  Once you set() an element, you
  295.         effectively give it to the array object to hold until you remove() it
  296.         or end() the object.  When in doubt about what is legal, read this
  297.         simple module's source!
  298.  
  299.         WARNING, key:  calling this method essentially makes the elements of
  300.         array.key READ-ONLY.  DO NOT change them (peeking allowed, but no
  301.         poking:), else risk corrupting the order and breaking binary search.
  302.  
  303.         WARNING, val:  It IS safe to change (okay to poke:) the elements of
  304.         array.val, eg, change the numeric value or swap out a string, etc,
  305.         just BE SMART ABOUT IT.  If val is dynamically allocated, it is the
  306.         programmer's responsibility to free the swapped-out val.
  307.  
  308.     INPUTS
  309.         key:LONG -- the key used to index val
  310.  
  311.         val:LONG -- the value associated with key
  312.  
  313.     EXCEPTIONS
  314.         May raise "MEM" or throw ASAR_EXCEPTION, ASAR_STACKOVERFLOW.
  315.  
  316.     SEE ALSO
  317.         associativeArray
  318.  
  319. ********/
  320.   DEF pos=0, rel=-1
  321.   IF self.tail>0
  322.     pos:=binarySearch(self, 0, self.tail-1, key, PIVOT(0,self.tail-1))
  323.     rel:=self.testKey(self.key[pos], key)
  324.   ENDIF
  325.   IF rel=EQ
  326.     self.disposeVal(self.val[pos])
  327.   ELSE
  328.     IF rel=GT THEN INC pos
  329.     makeRoom(self, pos)
  330.     self.tail:=self.tail+1
  331.   ENDIF
  332.   self.key[pos]:=key
  333.   self.val[pos]:=val
  334. ENDPROC
  335.  
  336. PROC get(searchKey) OF associativeArray
  337. /****** associativeArray/get ******************************
  338.  
  339.     NAME
  340.         get() of associativeArray --
  341.  
  342.     SYNOPSIS
  343.         associativeArray.get(LONG)
  344.  
  345.         associativeArray.get(searchKey)
  346.  
  347.     FUNCTION
  348.         Perform binary search for matching key and return its associated
  349.         value.
  350.  
  351.     INPUTS
  352.         searchKey:LONG -- the associated key used to identify a value
  353.  
  354.     RESULT
  355.         val:LONG -- value associated with key
  356.  
  357.         pos:LONG -- the position of the element in the array.
  358.  
  359.     EXCEPTIONS
  360.         Throws ASAR_EXCEPTION, ASAR_KEYNOTFOUND or
  361.         ASAR_EXCEPTION, ASAR_STACKOVERFLOW
  362.  
  363.     SEE ALSO
  364.         associativeArray
  365.  
  366. ********/
  367.   DEF pos
  368.   pos:=binarySearch(self, 0, self.tail-1, searchKey, PIVOT(0,self.tail-1))
  369.   IF self.testKey(self.key[pos], searchKey) THEN Throw(ASAR_EXCEPTION, ASAR_KEYNOTFOUND)
  370. ENDPROC self.val[pos],pos
  371.  
  372. PROC remove(searchKey) OF associativeArray
  373. /****** associativeArray/remove ******************************
  374.  
  375.     NAME
  376.         remove() of associativeArray --
  377.  
  378.     SYNOPSIS
  379.         associativeArray.remove(LONG)
  380.  
  381.         associativeArray.remove(searchKey)
  382.  
  383.     FUNCTION
  384.         Remove the key and value from the array and return them.
  385.  
  386.     INPUTS
  387.         searchKey:LONG -- the key of the element to be removed
  388.  
  389.     RESULT
  390.         key:LONG -- the key you passed
  391.  
  392.         val:LONG -- value associated with key
  393.  
  394.     EXCEPTIONS
  395.         Throws ASAR_EXCEPTION, ASAR_KEYNOTFOUND or
  396.         ASAR_EXCEPTION, ASAR_STACKOVERFLOW
  397.  
  398.     SEE ALSO
  399.         associativeArray
  400.  
  401. ********/
  402.   DEF pos, last, i, k:PTR TO LONG, v:PTR TO LONG, key, val
  403.   pos:=binarySearch(self, 0, self.tail-1, searchKey, PIVOT(0,self.tail-1))
  404.   IF self.testKey(self.key[pos], searchKey) THEN Throw(ASAR_EXCEPTION, ASAR_KEYNOTFOUND)
  405.   last:=self.tail-1
  406.   k:=self.key
  407.   v:=self.val
  408.   key:=k[pos]
  409.   val:=v[pos]
  410.   FOR i:=pos TO last
  411.     k[i]:=k[i+1]
  412.     v[i]:=v[i+1]
  413.   ENDFOR
  414.   k[i]:=0
  415.   v[i]:=0
  416.   self.tail:=self.tail-1
  417. ENDPROC key,val
  418.  
  419. /*===========================================================================*/
  420. /*=== Private Support Functions =============================================*/
  421. /*===========================================================================*/
  422.  
  423. PROC binarySearch(ar:PTR TO associativeArray, l, u, key, pivot)
  424. /****** /binarySearch ******************************
  425.  
  426.     NAME
  427.         binarySearch() --
  428.  
  429.     SYNOPSIS
  430.         binarySearch(PTR TO associativeArray, LONG, LONG, LONG, LONG)
  431.  
  432.         binarySearch(ar, l, u, key, pivot)
  433.  
  434.     FUNCTION
  435.         Recursive binary search of array ar.key.  Returns pos when
  436.         ar.key[pos] equals key, or when l=u.
  437.  
  438.     INPUTS
  439.         ar:PTR TO associativeArray -- array to work on
  440.  
  441.         l:LONG -- 
  442.  
  443.         u:LONG -- 
  444.  
  445.         key:LONG -- 
  446.  
  447.         pivot:LONG -- 
  448.  
  449.     RESULT
  450.         LONG -- index
  451.  
  452.     EXCEPTION
  453.         Throws ASAR_EXCEPTION, ASAR_STACKOVERFLOW
  454.  
  455. ********/
  456.   DEF rel
  457. #ifndef NO_SAFE_STACK
  458.   IF FreeStack()<1000 THEN Throw(ASAR_EXCEPTION, ASAR_STACKOVERFLOW)
  459. #endif
  460.   IF l=u THEN RETURN pivot
  461.   rel:=ar.testKey(ar.key[pivot], key)
  462.   IF rel=GT
  463.     IF l=pivot THEN RETURN pivot+1
  464.     l:=pivot
  465.   ELSEIF rel=LT
  466.     u:=pivot
  467.   ELSE
  468.     RETURN pivot
  469.   ENDIF
  470. ENDPROC binarySearch(ar, l, u, key, PIVOT(l,u))
  471.  
  472. PROC makeRoom(ar:PTR TO associativeArray, pos) HANDLE
  473. /****** /makeRoom ******************************
  474.  
  475.     NAME
  476.         makeRoom() -- Make room for an element.
  477.  
  478.     SYNOPSIS
  479.         makeRoom(PTR TO associativeArray, LONG)
  480.  
  481.         makeRoom(ar, pos)
  482.  
  483.     FUNCTION
  484.         Make a blank element at position pos (for an insert operation).
  485.         Expand the length of the array by 32 elements if necessary.
  486.  
  487.     INPUTS
  488.         ar:PTR TO associativeArray -- array to work on
  489.  
  490.         pos:LONG -- position to insert an element
  491.  
  492. ********/
  493.   DEF toKey=NIL:PTR TO LONG, toVal=NIL:PTR TO LONG
  494.   DEF fromKey:PTR TO LONG, fromVal:PTR TO LONG, i, last
  495.   fromKey:=ar.key
  496.   fromVal:=ar.val
  497.   /* Expand array if necessary and copy elements BEFORE pos, setup so that
  498.    * upper half of array is copied.  Else setup so that upper half of array
  499.    * is shifted right. **/
  500.   IF ar.tail=ar.len
  501.     toKey:=NewR(ar.len+32*4)
  502.     toVal:=NewR(ar.len+32*4)
  503.     last:=pos-1
  504.     FOR i:=0 TO last
  505.       toKey[i]:=fromKey[i]
  506.       toVal[i]:=fromVal[i]
  507.     ENDFOR
  508.   ELSE
  509.     toKey:=fromKey
  510.     toVal:=fromVal
  511.   ENDIF
  512.   /* Shift upper half of array one position to the right. */
  513.   INC pos
  514.   last:=ar.tail
  515.   FOR i:=last TO pos STEP -1
  516.     toKey[i]:=fromKey[i-1]
  517.     toVal[i]:=fromVal[i-1]
  518.   ENDFOR
  519.   /* Cleanup if the array was expanded. */
  520.   IF toKey<>fromKey
  521.     Dispose(fromKey)
  522.     Dispose(fromVal)
  523.     ar.key:=toKey
  524.     ar.val:=toVal
  525.     ar.len:=ar.len+32
  526.   ENDIF
  527. EXCEPT
  528.   /* The only recovery required is if toVal:=NewR(ar.len+32*4) raises "MEM". */
  529.   IF toKey THEN Dispose(toKey)
  530.   ReThrow()
  531. ENDPROC
  532.  
  533. PROC asList() OF associativeArray
  534. DEF valueList:PTR TO LONG,
  535.     keyList:PTR TO LONG,
  536.     index,
  537.     numberOfItems
  538.  
  539.   numberOfItems := self.tail
  540.  
  541.   valueList := List(numberOfItems)
  542.   keyList := List(numberOfItems)
  543.  
  544.   IF (valueList AND keyList)
  545.  
  546.     FOR index := 0 TO numberOfItems-1
  547.  
  548.       valueList[index] := self.val[index]
  549.       keyList[index] := self.key[index]
  550.  
  551. ->      WriteF('key: \d, value: $\h\n',self.key[index],self.val[index])
  552. ->      WriteF('key: \d, value: $\h\n\n',keyList[index],valueList[index])
  553.     ENDFOR
  554. ->    WriteF('\n')
  555.  
  556.     SetList(keyList,numberOfItems)
  557.     SetList(valueList,numberOfItems)
  558.   ENDIF
  559.  
  560.   RETURN keyList,valueList
  561.  
  562. ENDPROC
  563. /*EE folds
  564. -1
  565. 151 34 247 52 250 33 253 44 260 46 263 58 266 28 
  566. EE folds*/
  567.